Urnenmodell

Quelle: moderndive.com

Stichprobenziehung

Ergebnis einer Stichprobe

Ergebnis mehrerer Stichproben

Datensatz zum physischen Experiment

• insgesamt 33 Gruppen und damit 33 Stichprobenziehungen

library(moderndive)
tactile_prop_red

## # A tibble: 33 × 4
##    group            replicate red_balls prop_red
##    <chr>                <int>     <int>    <dbl>
##  1 Ilyas, Yohan             1        21     0.42
##  2 Morgan, Terrance         2        17     0.34
##  3 Martin, Thomas           3        21     0.42
##  4 Clark, Frank             4        21     0.42
##  5 Riddhi, Karina           5        18     0.36
##  6 Andrew, Tyler            6        19     0.38
##  7 Julia                    7        19     0.38
##  8 Rachel, Lauren           8        11     0.22
##  9 Daniel, Caroline         9        15     0.3 
## 10 Josh, Maeve             10        17     0.34
## # ℹ 23 more rows

Stichprobenverteilung

library(tidyverse)
ggplot(tactile_prop_red, aes(x = prop_red)) +
  geom_histogram(binwidth = 0.05, boundary = 0.4,
                 color = "white") +
  scale_y_continuous(limits = c(0, 10), breaks = c(0:10)) +
  labs(x = "Anteil roter Kugeln aus insgesamt 50 (roten und weißen) Kugeln",
       y="Anzahl",
       title = "Verteilung von 33 Anteilswerten roter Kugeln")

Wahre Verteilung

Daten

bowl

## # A tibble: 2,400 × 2
##    ball_ID color
##      <int> <chr>
##  1       1 white
##  2       2 white
##  3       3 white
##  4       4 red  
##  5       5 white
##  6       6 white
##  7       7 red  
##  8       8 white
##  9       9 red  
## 10      10 white
## # ℹ 2,390 more rows

Anzahl und Anteil roter Kugeln

red_true <- bowl %>%
               summarize(Anzahl_rot = sum(color == "red"),
                     Anteil_rot = sum(color == "red")/length(color)
            )
red_true  %>%
    mutate(Anteil_rot=paste0(Anteil_rot*100,"%"))

## # A tibble: 1 × 2
##   Anzahl_rot Anteil_rot
##        <int> <chr>     
## 1        900 37.5%

(Virtuelles) Sampling und Punktschätzung

Unterschiedliche Schaufelgrößen

“Kleine Schaufel” (Stichprobengröße n = 25)

• 1000 Ziehungen mit der kleinen Schaufel

n <- 25
rep <- 1000
virtual_samples_25 <- bowl %>%
                        rep_sample_n(size = n,
                                     reps = rep)
virtual_samples_25

## # A tibble: 25,000 × 3
## # Groups:   replicate [1,000]
##    replicate ball_ID color
##        <int>   <int> <chr>
##  1         1    1139 red  
##  2         1    1121 white
##  3         1     627 red  
##  4         1    1717 red  
##  5         1    1143 white
##  6         1    1923 white
##  7         1     575 white
##  8         1    2341 white
##  9         1     799 white
## 10         1     452 red  
## # ℹ 24,990 more rows

• “Auszählen” der roten Kugeln für jede der 1000 Ziehungen als Punktschätzung \((\hat{p})\) des Anteils roter Kugeln

virtual_prop_red_25 <- virtual_samples_25 %>%
                              group_by(replicate) %>%
                              summarize(red = sum(color == "red")) %>%
                              mutate(prop_red = red / n)
virtual_prop_red_25

## # A tibble: 1,000 × 3
##    replicate   red prop_red
##        <int> <int>    <dbl>
##  1         1    12     0.48
##  2         2     7     0.28
##  3         3    10     0.4 
##  4         4     8     0.32
##  5         5     7     0.28
##  6         6    11     0.44
##  7         7    12     0.48
##  8         8    12     0.48
##  9         9     9     0.36
## 10        10    11     0.44
## # ℹ 990 more rows

• Dataviz der Stichprobenverteilung (englisch: Sampling Distribution)

virtual_prop_red_25 %>% 
  ggplot(aes(x = prop_red)) +
      geom_histogram(binwidth = 0.05, boundary = 0.4, color = "white") +
      labs(x = paste0("Anteil roter Kugeln (aus ",n,")"),
           title = paste0("Kleine Schaufel (n=",n,")")) +
      geom_vline(xintercept = red_true$Anteil_rot,color='red')

“Mittlere Schaufel” (Stichprobengröße n = 50)

• 1000 Ziehungen mit der mittleren Schaufel

n <- 50
virtual_samples_50 <- bowl %>%
                         rep_sample_n(size = n,
                                      reps = rep)

• “Auszählen” der roten Kugeln für jede der 1000 Ziehungen als Punktschätzung \((\hat{p})\) des Anteils roter Kugeln

virtual_prop_red_50 <- virtual_samples_50 %>%
                              group_by(replicate) %>%
                              summarize(red = sum(color == "red")) %>%
                              mutate(prop_red = red / n)
virtual_prop_red_50

## # A tibble: 1,000 × 3
##    replicate   red prop_red
##        <int> <int>    <dbl>
##  1         1    23     0.46
##  2         2    16     0.32
##  3         3    19     0.38
##  4         4    19     0.38
##  5         5    21     0.42
##  6         6    24     0.48
##  7         7    20     0.4 
##  8         8    13     0.26
##  9         9    23     0.46
## 10        10    13     0.26
## # ℹ 990 more rows

• Dataviz der Stichprobenverteilung (Sampling Distribution)

virtual_prop_red_50 %>% 
  ggplot(aes(x = prop_red)) +
      geom_histogram(binwidth = 0.05, boundary = 0.4, color = "white") +
      labs(x = paste0("Anteil roter Kugeln (aus ",n,")"),
           title = paste0("Kleine Schaufel (n=",n,")")) +
      geom_vline(xintercept = red_true$Anteil_rot,color='red')

“Große Schaufel” (Stichprobengröße n = 100)

• 1000 Ziehungen mit der großen Schaufel

n<-100
virtual_samples_100 <- bowl %>%
                          rep_sample_n(size = n,
                                       reps = rep)
virtual_samples_100

## # A tibble: 100,000 × 3
## # Groups:   replicate [1,000]
##    replicate ball_ID color
##        <int>   <int> <chr>
##  1         1    1264 white
##  2         1    1929 red  
##  3         1    1900 white
##  4         1     907 red  
##  5         1    1948 white
##  6         1    1366 white
##  7         1    1126 white
##  8         1    1122 white
##  9         1     309 white
## 10         1    2099 white
## # ℹ 99,990 more rows

• “Auszählen” der roten Kugeln für jede der 1000 Ziehungen als Punktschätzung \((\hat{p})\) des Anteils roter Kugeln

virtual_prop_red_100 <- virtual_samples_100 %>%
                              group_by(replicate) %>%
                              summarize(red = sum(color == "red")) %>%
                              mutate(prop_red = red / n)
virtual_prop_red_100

## # A tibble: 1,000 × 3
##    replicate   red prop_red
##        <int> <int>    <dbl>
##  1         1    31     0.31
##  2         2    41     0.41
##  3         3    35     0.35
##  4         4    34     0.34
##  5         5    41     0.41
##  6         6    29     0.29
##  7         7    45     0.45
##  8         8    33     0.33
##  9         9    43     0.43
## 10        10    40     0.4 
## # ℹ 990 more rows

• Dataviz der Stichprobenverteilung (Sampling Distribution)

virtual_prop_red_100 %>% 
  ggplot(aes(x = prop_red)) +
      geom_histogram(binwidth = 0.05, boundary = 0.4, color = "white") +
      labs(x = paste0("Anteil roter Kugeln (aus ",n,")"),
           title = paste0("Kleine Schaufel (n=",n,")")) +
      geom_vline(xintercept = red_true$Anteil_rot,color='red')

Grundproblem der induktiven Statistik

• Ergebnisse einer Stichprobe können verallgemeinert werden, wenn Aussagen für die Stichprobe auf die Grundgesamtheit übertragen werden können

• Repräsentativität der Stichprobe, wenn \(\hat{p}\) eine gute Schätzung für den wahren Anteil \(p\) ist

• Stichprobenziehung ist unverzerrt (unbiased), wenn jedes Element der Grundgesamtheit dieselbe Auswahlwahrscheinlichkeit hat

\(\Rightarrow\) Bedeutung der Zufallsaufwahl bei der Datenerhebung (!)

• Statistische Inferenz als Schätzung einer unbekannten Größe der Grundgesamtheit auf Basis einer Stichprobe

• Entscheidende Frage: Kennen wir den wahren Wert?

Wenn der wahre Wert unbekannt ist

(Virtuelles) Ziehen einer Stichprobe

n <- 50
virtual_shovel <- bowl %>% 
                     rep_sample_n(size = n)
virtual_shovel

## # A tibble: 50 × 3
## # Groups:   replicate [1]
##    replicate ball_ID color
##        <int>   <int> <chr>
##  1         1     264 white
##  2         1    2244 white
##  3         1     519 white
##  4         1     352 red  
##  5         1     366 white
##  6         1     820 red  
##  7         1    1038 red  
##  8         1     633 red  
##  9         1    1298 white
## 10         1     947 white
## # ℹ 40 more rows

Anzahl und Anteil der roten Kugeln

virtual_shovel %>% 
  summarize(num_red = sum(color == "red")) %>% 
  mutate(prop_red = num_red /n)

## # A tibble: 1 × 3
##   replicate num_red prop_red
##       <int>   <int>    <dbl>
## 1         1      22     0.44

• prop_red als Punktschätzung \((\hat{p}=\) 0.44) für den wahren Anteil \(p=\) 0.375 der roten Kugeln in der Grundgesamtheit.

Statistische Inferenz

• Weil es sich um eine Zufallsstichprobe (hier \(n=50\)) handelt (alle Kugeln hatten dieselbe Auswahlwahrscheinlichkeit), liefert sie ein unverzerrtes und repräsentatives Bild des Urnen-Inhalts.

• Jedes Ergebnis der Stichprobe (hier: mittlere Schaufel) kann auf die Grundgesamtheit (hier: die Urne) verallgemeinert werden

• Der Anteil roter Kugeln in der Stichprobe \((\hat{p})\) ist eine gute Schätzung des Anteils roter Kugeln in der Grundgesamtheit \((N=2400)\)

• Statt einer Vollerhebung bzw. dem Auszählen der Urne, können wir von der Schaufel-Stichprobe auf die Verteilung in der Urne schließen.

Stichprobenverteilung

• Einmalige Stichprobe mit \(n=50\) lieferte \(\hat{p}=\) 0.44

• Virtuelles Sampling als 1000-malig wiederholte Zufallsstichprobe mit jeweils \(n=50\) lieferte Stichprobenverteilung als mehrfach wiederholte Zufallsstichprobe

• Drei Stichprobenverteilungen:

Reliabilität und Validität

• Erinnerung: Zufallsstichprobe stellt unverzerrte (valide) Punktschätzung sicher

Stichprobenverteilungen…

…und wahrer Wert (rote Linien)

• Obs! Geringere Streuung bei größeren Stichproben.

• Standardfehler als Standardabweichung einer Stichprobenverteilung

• Maß für die Reliabilität

Vergleich der Standardfehler

• Obs! Die Standardabweichung der Stichprobenverteilung wird als Standardfehler bezeichnet

• n =25

virtual_prop_red_25 %>%
  summarize(sd = sd(prop_red))

## # A tibble: 1 × 1
##       sd
##    <dbl>
## 1 0.0943

• n = 50

virtual_prop_red_50 %>%
  summarize(sd = sd(prop_red))

## # A tibble: 1 × 1
##       sd
##    <dbl>
## 1 0.0710

• n = 100

virtual_prop_red_100 %>%
  summarize(sd = sd(prop_red))

## # A tibble: 1 × 1
##       sd
##    <dbl>
## 1 0.0484

Zentraler Grenzwertsatz

Mit zunehmendem Stichprobenumfang nähert sich (1) die Stichprobenverteilung eines Punktschätzers (bspw. Anteil roter Kugeln) einer Normalverteilung an und nimmt (2) die Streuung dieser Stichprobenverteilungen ab ( kleinere Standardfehler).

Die Normalverteilung der Stichprobenverteilung resultiert dabei unabhängig von der Verteilung in der Grundgesamtheit - solange die für die Stichproben jeweils berechneten Mittelwerte auf unabhängigen Zufallsvariablen basieren. Die Unabhängigkeit wird dabei durch die Zufälligkeit der Stichprobenziehung sichergestellt.

Beispiele, vgl. Skript Wahrscheinlichkeitstheorie & Zufallsvariablen

Mögliche Punktschätzer

Im bisher verwendeten Beispiel ging es um den Anteil roter Kugeln, mithin um die Schätzung eines Anteilswerts. Das Konzept der Stichprobenziehung kann jedoch auch zur Schätzung anderer Parameter einer Grundgesamtheit verwendet werden:

Punktschätzung vs. Intervallschätzung

Ermittlung von Konfidenzintervallen

• Schritt 1: Festlegung eines Konfidenzniveaus (Vertrauensniveaus)
  • 90%
  • 95%
  • 99%
• Schritt 2: Wahl einer Methode
  • Traditionelle Methode auf Basis einer Verteilungsannahme
  • Bootstrapping-Methoden
    • Perzentil-Ansatz
    • Standardfehler-Ansatz
• Schritt 3: Statistik(en) berechnen
  • Mittelwert/Schätzwert
  • Standardfehler
• Schritt 4: ggf. Visualisierung und Interpretation

Einzelne Stichprobe aus dem physischen Experiment

• Quelle: moderndive.com

• Ilyas und Yohan als eine von 33 Gruppen

bowl_sample_1

## # A tibble: 50 × 1
##    color
##    <chr>
##  1 white
##  2 white
##  3 red  
##  4 red  
##  5 white
##  6 white
##  7 red  
##  8 white
##  9 white
## 10 white
## # ℹ 40 more rows

• “Auszählen” der roten Kugeln und Berechnung des Anteilswerts roter Kugeln in der Stichprobe von Ilyas und Yohan:

stats_sample_1 <- bowl_sample_1 %>%
                  summarize(Anzahl_rot=sum(color=='red'),
                            Anteil_rot=sum(color=='red')/
                                                length(color))
stats_sample_1

## # A tibble: 1 × 2
##   Anzahl_rot Anteil_rot
##        <int>      <dbl>
## 1         21       0.42

In der Stichprobe von Ilyas und Yohan befinden sich insgesamt 21 rote Kugeln, d.h. der Anteil roter Kugeln entspricht in ihrer Stichprobe 42%.

Nutzung der Funktionen im infer-Paket

Schritt 1: specify()

library(infer)
#bowl_sample_1 %>%        
#    specify(response = color)   # funktioniert nicht - "success" (also das "Ereignis A") muss definiert werden!

bowl_sample_1 %>%
    specify(response = color, success = "red")

## Response: color (factor)
## # A tibble: 50 × 1
##    color
##    <fct>
##  1 white
##  2 white
##  3 red  
##  4 red  
##  5 white
##  6 white
##  7 red  
##  8 white
##  9 white
## 10 white
## # ℹ 40 more rows

Schritt 2: generate()

• Replikation mittels Bootstrapping-Methode, d.h. Ziehen mit (!) Zurücklegen. Option bootstrap

• Alternativ: permute (ohne Zurücklegen)

bowl_sample_1 %>%
  specify(response = color, success = "red") %>%
  generate(reps = 1000, type = "bootstrap")

## Response: color (factor)
## # A tibble: 50,000 × 2
## # Groups:   replicate [1,000]
##    replicate color
##        <int> <fct>
##  1         1 red  
##  2         1 white
##  3         1 white
##  4         1 red  
##  5         1 white
##  6         1 white
##  7         1 white
##  8         1 white
##  9         1 white
## 10         1 white
## # ℹ 49,990 more rows

Schritt 3: calculate()

• Statistische Kennzahl(en) für die Resamples berechnen

sample_1_bootstrap <- bowl_sample_1 %>%
                           specify(response = color,
                                   success = "red") %>%
                           generate(reps = 1000,
                                    type = "bootstrap") %>%
                           calculate(stat = "prop")
sample_1_bootstrap

## Response: color (factor)
## # A tibble: 1,000 × 2
##    replicate  stat
##        <int> <dbl>
##  1         1  0.38
##  2         2  0.42
##  3         3  0.38
##  4         4  0.52
##  5         5  0.52
##  6         6  0.48
##  7         7  0.44
##  8         8  0.4 
##  9         9  0.4 
## 10        10  0.32
## # ℹ 990 more rows

Schritt 4: visualize()

• Konfidenzintervall ermitteln mit get_confidence_interval()

• Optionen

  • Konfidenzniveau (level)
  • Methode
    • Perzentile (type = “percentile”)
    • Standardfehler (type = “se”)

## # A tibble: 1 × 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1     0.28     0.56

• Visualisierung des Konfidenzintervalls

sample_1_bootstrap %>%
        visualize(bins = 15) +
        shade_confidence_interval(endpoints = percentile_ci_1) +
        geom_vline(xintercept = 0.42, linetype = "dashed")

Interpretation Konfidenzintervall

Perzentil-Methode

• Beispiel 95%-Konfidenzintervall (Perzentil-Methode)

Standardfehler-Methode

• Beispiel 80%-Konfidenzintervall (Standardfehler-Methode)

Stichprobenverteilung vs. Bootstrap-Verteilung

Stichprobenverteilung

• Beispiel: 1000 virtuelle Stichproben mit \(n=50\) aus der Urne (Obs! Ziehen aus der wahren Verteilung)

• Stichprobenverteilung von \(\hat{p}\) berechnen

• Visualisierung der Stichprobenverteilung von \(\hat{p}\)

• Obs! rote Linie: wahrer Anteil \((p)\) roter Kugeln

• Obs! bei Nutzung der rep_sample_n()-Funktion wird standardmäßig ohne zurücklegen gezogen (replace=FALSE)

• Standardfehler der Stichprobenverteilung

## # A tibble: 1 × 1
##       se
##    <dbl>
## 1 0.0662

Bootstrapping-Verteilung

• Beim Bootstrapping wird aus den Daten (hier: der von Ilyas und Yohan gezogenen Stichprobe) mit (!) zurücklegen gezogen

• Visualisierung der Bootstrap-Verteilung

• Obs! gestrichelt - der Anteilswert \((\hat{p})\), den Ilyas + Yohan in ihrer Stichprobe ermittelt haben

• Standardfehler Bootstrap-Verteilung

## # A tibble: 1 × 1
##       se
##    <dbl>
## 1 0.0714

• Interpretation:

  • Die Bootstrap-Verteilung hat typischerweise ein von der Stichprobenverteilung abweichendes Zentrum. Mithin kann bootstrapping die Qualität der Schätzung (hier \(\hat{p}\)) nicht verbessern.

  • Auch wenn die Bootstrap-Verteilung nicht dasselbe Zentrum wie die Stichprobenverteilung hat, wird sie sehr wahrscheinlich eine ähnliche Form und Streuung aufweisen. Damit liefert die Bootstrapping-Methode eine gute Schätzung für den Standardfehler.